unit U.JSON.CodeFactory;

interface
uses
  System.Classes,
  System.SysUtils,
  JsonDataObjects,
  Winapi.Windows,
  System.Generics.Collections;
type
{ TObjListItem }

  TPropertyListItem = class(TObject)
  protected
    FVariableList:TStringList;
    FPropertyList:TStringList;
    FCodeList:TStringList;
    FMethodList:TStringList;
    FCreateList:TStringList;
    FDestroyList:TStringList;
    FName:string;
    FTyp:string;
    FObjName:string;
    procedure MyCreate(AObjName:string;AName:string;ATyp:string);
  public
    constructor CreateProperty(AObjName:string;AName:string;ATyp:string);
    constructor CreatePropertyObject(AObjName:string;AName:string;ATyp:string);
    constructor CreateArrayObject(AObjName:string;AName:string;ATyp:string);
    constructor CreateArrayTyp(AObjName:string;AName:string;ATyp:string);
    property VariableList:TStringList read FVariableList;
    property PropertyList:TStringList read FPropertyList;
    property CodeList:TStringList read FCodeList;
    property MethodList:TStringList read FMethodList;
    destructor Destroy; override;
    procedure AddProperty;
    procedure AddArrayObject;
    procedure AddArrayTyp;
    procedure AddArrayTypObject;
  published

  end;
{ TObjListItem }

  TObjListItem = class(TObject)
  private

  protected
    FObjName:string;
    FPropertyList:TDictionary<string,TPropertyListItem>;
  public
    property ObjectName:string read FObjName;
    property PropertyList:TDictionary<string,TPropertyListItem> read FPropertyList;
    function AddProperty(AObjectName:string;AName:string;ATyp:string):Boolean;
    function AddPropertyObject(AObjectName:string;AName:string;ATyp:string):Boolean;
    function AddArray(AObjectName:string;AName:string;ATyp:string):Boolean;
    constructor Create;
    destructor Destroy; override;
  published

  end;



{ TJSONCodeFactory }

  TJSONCodeFactory = class(TObject)
  protected
    FJSONIsNullToString :Boolean;
    FJSonObject:TJsonObject;
    FObjectName:string;
    FObjectList:TDictionary<string,TObjListItem>;
    procedure ObjListNotify(Sender: TObject; const Item: TObjListItem;Action: TCollectionNotification);

    function AddProperty(AObjectName:string;AName:string;ATyp:string):Boolean;
    function AddPropertyObject(AObjectName:string;AName:string;ATyp:string):Boolean;
    function AddArray(AObjectName:string;AName:string;ATyp:string):string;

    function ParseObject(AFather:string;AJsonObject:TJsonObject):Boolean;
    function ParseString(AFather:string;AName:string):Boolean;
    function ParseTyp(AFather:string;AName:string;TypStr:string):Boolean;
    function ParseTypObject(AFather:string;AName:string;TypStr:string):Boolean;
    function ParseArray(AFather:string;AName:string;TypStr:string):STRING;
  public
    function Parse(JSONStr:string):Boolean;
    function SaveToFile(Path,FS:STRING):Boolean;
    constructor Create(AObjectName:string;AJSONIsNullToString:Boolean = True);
    destructor Destroy; override;
  end;


implementation

{ TJSONCodeFactory }

function TJSONCodeFactory.AddArray(AObjectName, AName, ATyp: string): string;
var
  L_Item:TObjListItem;
begin
   { TODO -otest -c : 重名ObjectName处理 2023/8/10 11:19:39 }
  if NOT FObjectList.ContainsKey(AObjectName)  then
  begin
    L_Item := TObjListItem.Create();
  end
  ELSE
   L_Item := FObjectList.Items[AObjectName];

    L_Item.AddArray(AObjectName,AName,ATyp);

    if NOT FObjectList.ContainsKey(AObjectName)  then
      FObjectList.Add(AObjectName,L_Item);

    Result := AObjectName;
end;

function TJSONCodeFactory.AddProperty(AObjectName, AName: string;ATyp:string): Boolean;
var
  L_Item:TObjListItem;
begin
  Result := False;
  if FObjectList.ContainsKey(AObjectName)  then
    L_Item := FObjectList.Items[AObjectName]
  ELSE
   L_Item := TObjListItem.Create();

  L_Item.AddProperty(AObjectName,AName,ATyp);

  { TODO -otest -c : 不应当有重名的Property 2023/8/10 11:20:03 }
  if NOT FObjectList.ContainsKey(AObjectName)  then
    FObjectList.Add(AObjectName,L_Item)
 // else
   // raise Exception.Create('AddProperty FObjectList.ContainsKey(AObjectName)');
end;

function TJSONCodeFactory.AddPropertyObject(AObjectName, AName,
  ATyp: string): Boolean;
var
  L_Item:TObjListItem;
begin
  Result := False;
  if FObjectList.ContainsKey(AObjectName)  then
    L_Item := FObjectList.Items[AObjectName]
  ELSE
   L_Item := TObjListItem.Create();

  L_Item.AddPropertyObject(AObjectName,AName,ATyp);

  if NOT FObjectList.ContainsKey(AObjectName)  then
    FObjectList.Add(AObjectName,L_Item);
end;

constructor TJSONCodeFactory.Create(AObjectName:string;AJSONIsNullToString:Boolean = True);
begin
  FJSONIsNullToString := AJSONIsNullToString;
  FObjectName := AObjectName;
  FObjectList := TDictionary<string,TObjListItem>.Create;
  FObjectList.OnValueNotify := ObjListNotify;
end;

destructor TJSONCodeFactory.Destroy;
begin
  FObjectList.Free;
  inherited;
end;

procedure TJSONCodeFactory.ObjListNotify(Sender: TObject;
  const Item: TObjListItem; Action: TCollectionNotification);
begin
  if Action =  cnRemoved then
    Item.Free;
end;

function TJSONCodeFactory.Parse(JSONStr: string):Boolean;
begin
  FJSonObject := TJsonBaseObject.Parse(JSONStr) as TJsonObject;

  Result := ParseObject(FObjectName,FJSonObject);
  FJSonObject.Free;
end;

function TJSONCodeFactory.ParseArray(AFather, AName, TypStr: string): string;
begin
  Result := AddArray(AFather,AName,TypStr);
end;

function TJSONCodeFactory.ParseObject(AFather:string;AJsonObject: TJsonObject): Boolean;
var
  I:Integer;
begin
  OutputDebugString(PWideChar(AFather));
  if AFather = 'TQuireContextchildData' then
    Sleep(100);
  Result := False;
  try
    for i := 0 to AJsonObject.Count - 1 do
    begin
      OutputDebugString(PWideChar(AJsonObject.Names[I]));
      case AJsonObject.Items[i].Typ of
        jdtNone:
        begin
          { TODO -otest -c : jdtNone 2023/8/5 10:46:44 }
          raise Exception.Create('Typ jdtNone');
        end;
        jdtString:
        begin
          Result := ParseString(AFather,AJsonObject.Names[I]);
        end;
        jdtInt:
        begin
          Result := ParseTyp(AFather,AJsonObject.Names[I],'Integer');
        end;
        jdtLong:
        begin
          Result := ParseTyp(AFather,AJsonObject.Names[I],'Int64');
        end;
        jdtULong:
        begin
          Result := ParseTyp(AFather,AJsonObject.Names[I],'UInt64');
        end;
        jdtFloat:
        begin
          Result := ParseTyp(AFather,AJsonObject.Names[I],'Double');
        end;
        jdtDateTime:
        begin
          Result := ParseTyp(AFather,AJsonObject.Names[I],'TDateTime');
        end;
        jdtUtcDateTime:
        begin
          Result := ParseTyp(AFather,AJsonObject.Names[I],'TDateTime');
        end;
        jdtBool:
        begin
          Result := ParseTyp(AFather,AJsonObject.Names[I],'Boolean');
        end;
        jdtArray:
        begin
          { TODO 1 -otest -c : Improve various situations of jdtArray 2023/8/5 10:46:17 }
          case AJsonObject.Items[I].ArrayValue.Items[0].Typ of
          jdtNone:
          begin
            raise Exception.Create('Typ jdtNone');
            { TODO -otest -c : jdtNone 2023/8/5 10:46:44 }
          end;
          jdtString:
          begin
            ParseArray(AFather,AJsonObject.Names[I],'String');
          end;
          jdtInt:
          begin
            ParseArray(AFather,AJsonObject.Names[I],'Integer');
          end;
          jdtLong:
          begin
            ParseArray(AFather,AJsonObject.Names[I],'Int64');
          end;
          jdtULong:
          begin
            ParseArray(AFather,AJsonObject.Names[I],'UInt64');
          end;
          jdtFloat:
          begin
            ParseArray(AFather,AJsonObject.Names[I],'Double');
          end;
          jdtDateTime:
          begin
            ParseArray(AFather,AJsonObject.Names[I],'TDateTime');
          end;
          jdtUtcDateTime:
          begin
            ParseArray(AFather,AJsonObject.Names[I],'TDateTime');
          end;
          jdtBool:
          begin
            ParseArray(AFather,AJsonObject.Names[I],'Boolean');
          end;
          jdtArray:
          begin
            { TODO -otest -c : 数组中嵌套数组处理 2023/8/10 10:34:46 }
            raise Exception.Create('Typ array jdtArray');
          end;
          jdtObject:
          begin
            ParseArray(AFather,AJsonObject.Names[I],'Object');
            Result := ParseObject(Format('%s%sData',[AFather,AJsonObject.Names[I]]),AJsonObject.Items[I].ArrayValue.Items[0].ObjectValue);
          end
          end;
        end;
        jdtObject:
        begin
          if AJsonObject.Items[I].IsNull then
          begin
            if FJSONIsNullToString then
            begin
              Result := ParseString(AFather,AJsonObject.Names[I]);
            end
            else
            begin
              raise Exception.Create('Typ jdtObject IsNull');
              { TODO 3 -otest -c : Handle jdtOject equal to NULL 2023/8/4 15:19:57 }
            end;
          end
          else
          begin
            //Recursion, processing the content in the next level of json
            Result := ParseTypObject(AFather,AJsonObject.Names[I],Format('%s%sData',[AFather,AJsonObject.Names[I]]));
            Result := ParseObject(Format('%s%sData',[AFather,AJsonObject.Names[I]]),AJsonObject.Items[I].ObjectValue);
          end;
        end;
      end;
    end;
  finally

  end;
end;

function TJSONCodeFactory.ParseString(AFather, AName: string): Boolean;
begin
  Result := AddProperty(AFather,AName,'String');
end;

function TJSONCodeFactory.ParseTyp(AFather, AName, TypStr: string): Boolean;
begin
  Result := AddProperty(AFather,AName,TypStr);
end;

function TJSONCodeFactory.ParseTypObject(AFather, AName,
  TypStr: string): Boolean;
begin
  Result := AddPropertyObject(AFather,AName,TypStr);
end;

function TJSONCodeFactory.SaveToFile(Path,FS: STRING): Boolean;
var
  Ary:TArray<TObjListItem>;
  Itm:TObjListItem;
  Ary2:TArray<TPropertyListItem>;
  PRITM:TPropertyListItem;
  fsobj:TStringList;
  i: Integer;
begin
  fsobj := TStringList.Create;

  fsobj.Add(Format('unit %s;',[FS]));
  fsobj.Add('//This unit is generated by JSONCodeFactory.');

  fsobj.Add('interface');
  fsobj.Add('uses');
  fsobj.Add('  System.Generics.Collections;');
  fsobj.Add('');
  fsobj.Add('type');
  fsobj.Add('');
  
  Ary := FObjectList.Values.ToArray;

  for Itm in Ary do
  begin
    fsobj.Add(Format('  %s = class;',[Itm.ObjectName]));
  end;

  fsobj.Add('');
  for Itm in Ary do
  begin
    fsobj.Add(Format('  %s = class(TObject)',[Itm.ObjectName]));
    fsobj.Add('    private');
    Ary2 := Itm.PropertyList.Values.ToArray;
    for PRITM in Ary2 do
    begin
      for I := 0 to PRITM.FVariableList.Count - 1 do
      BEGIN
        fsobj.Add(Format('      %s',[PRITM.FVariableList.Strings[I]]));
      END;
    end;
    fsobj.Add('    protected');
    for PRITM in Ary2 do
    begin
      for I := 0 to PRITM.FMethodList.Count - 1 do
      BEGIN
        fsobj.Add(Format('      %s',[PRITM.FMethodList.Strings[I]]));
      END;
    end;
    fsobj.Add('    public');

    fsobj.Add('      constructor Create();');
    fsobj.Add('      destructor Destroy;');

    fsobj.Add('    published');

    for PRITM in Ary2 do
    begin
      for I := 0 to PRITM.FPropertyList.Count - 1 do
      BEGIN
        fsobj.Add(Format('      %s',[PRITM.FPropertyList.Strings[I]]));
      END;
    end;

    fsobj.Add('  end;');
    fsobj.Add('');
  end;
  
  fsobj.Add('implementation');
  fsobj.Add('');
  Ary := FObjectList.Values.ToArray;
  for Itm in Ary do
  begin
    Ary2 := Itm.PropertyList.Values.ToArray;
    for PRITM in Ary2 do
    begin
      for I := 0 to PRITM.FCodeList.Count - 1 do
      BEGIN
        fsobj.Add(Format('  %s',[PRITM.FCodeList.Strings[I]]));
      END;

    end;

    fsobj.Add(Format('constructor %s.Create();',[PRITM.FObjName]));
    fsobj.Add('begin'); 
    for PRITM in Ary2 do
    begin
      for I := 0 to PRITM.FCreateList.Count - 1 do
      begin  
        fsobj.Add(PRITM.FCreateList.Strings[i]);
      end;
    end;
    fsobj.Add('end;');
    
    fsobj.Add('');
    
    fsobj.Add(Format('destructor %s.Destroy;',[PRITM.FObjName]));
    fsobj.Add('begin'); 
    for PRITM in Ary2 do
    begin
      for I := 0 to PRITM.FDestroyList.Count - 1 do
      begin  
        fsobj.Add(PRITM.FDestroyList.Strings[i]);
      end;
    end;
    fsobj.Add('end;');
    
    fsobj.Add('');
  end;
  fsobj.Add('end.');

  fsobj.SaveToFile(Path + fs + '.pas');

end;

{ TObjListItem }

procedure TPropertyListItem.AddArrayObject;
begin
  FVariableList.Add(Format('F%s:TObjectList<%s>;',[FName,FTyp]));

  FCreateList.Add(Format('  F%s:= TObjectList<%s>.Create;',[FName,FTyp]));

  FDestroyList.Add(Format('  F%s.Free;',[FName])); 

 FPropertyList.Add(Format('property %s:TObjectList<%s> read F%s write F%s;',[FName,FTyp,FName,FName]));
end;

procedure TPropertyListItem.AddArrayTyp;
begin
  FVariableList.Add(Format('F%s:TList<%s>;',[FName,FTyp]));

  FCreateList.Add(Format('  F%s:= TList<%s>.Create;',[FName,FTyp]));

  FDestroyList.Add(Format('  F%s.Free;',[FName]));

 FPropertyList.Add(Format('property %s:TList<%s> read F%s write F%s;',[FName,FTyp,FName,FName]));
end;

procedure TPropertyListItem.AddArrayTypObject;
begin
  FVariableList.Add(Format('F%s:%s;',[FName,FTyp]));

  FCreateList.Add(Format('  F%s:= %s.Create;',[FName,FTyp]));
  FDestroyList.Add(Format('  F%s.Free;',[FName]));

  FPropertyList.Add(Format('property %s:%s read F%s write F%s;',[FName,FTyp,FName,FName]));
end;

procedure TPropertyListItem.AddProperty;
begin
  FVariableList.Add(Format('F%s:%s;',[FName,FTyp]));


  FPropertyList.Add(Format('property %s:%s read F%s write F%s;',[FName,FTyp,FName,FName]));
end;



constructor TPropertyListItem.CreateArrayObject(AObjName, AName, ATyp: string);
begin
  MyCreate(AObjName,AName,ATyp);
  AddArrayObject;
end;

constructor TPropertyListItem.CreateArrayTyp(AObjName, AName, ATyp: string);
begin
  MyCreate(AObjName,AName,ATyp);
  AddArrayTyp;
end;

constructor TPropertyListItem.CreateProperty(AObjName:string;AName:string;ATyp:string);
begin
  MyCreate(AObjName,AName,ATyp);
  AddProperty;
end;

constructor TPropertyListItem.CreatePropertyObject(AObjName, AName,
  ATyp: string);
begin
  MyCreate(AObjName,AName,ATyp);
  AddArrayTypObject;
end;

destructor TPropertyListItem.Destroy;
begin
  FVariableList.Free;
  FPropertyList.Free;
  FCodeList.Free;
  FMethodList.Free;
  FCreateList.Free;
  FDestroyList.Free;
  inherited;
end;

procedure TPropertyListItem.MyCreate(AObjName:string;AName:string;ATyp:string);
begin
  FVariableList := TStringList.Create;
  FPropertyList := TStringList.Create;
  FCodeList := TStringList.Create;
  FMethodList := TStringList.Create;
  FCreateList := TStringList.Create;
  FDestroyList := TStringList.Create;
  FObjName := AObjName;
  FName := AName;
  FTyp := ATyp;
end;

{ TObjListItem }

function TObjListItem.AddArray(AObjectName, AName, ATyp: string): Boolean;
begin
  FObjName := AObjectName;
  if ATyp = 'Object' then
    FPropertyList.AddOrSetValue(AName,TPropertyListItem.CreateArrayObject(AObjectName, AName, Format('%s%sData',[FObjName,AName])))
  else
    FPropertyList.AddOrSetValue(AName,TPropertyListItem.CreateArrayTyp(AObjectName, AName, ATyp));

  Result := True;
end;

function TObjListItem.AddProperty(AObjectName, AName, ATyp: string): Boolean;
begin
  FObjName := AObjectName;
  FPropertyList.AddOrSetValue(AName,TPropertyListItem.CreateProperty(AObjectName, AName, ATyp));
end;

function TObjListItem.AddPropertyObject(AObjectName, AName,
  ATyp: string): Boolean;
begin
  FObjName := AObjectName;
  FPropertyList.AddOrSetValue(AName,TPropertyListItem.CreatePropertyObject(AObjectName, AName, ATyp));
end;

constructor TObjListItem.Create;
begin
  FPropertyList := TDictionary<string,TPropertyListItem>.Create;
end;

destructor TObjListItem.Destroy;
begin
  FPropertyList.Free;
  inherited;
end;

end.